home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / txl / rexxmdl2.lha / RexModula2 / Txl / rmi.Txl < prev   
Text File  |  1992-02-26  |  12KB  |  432 lines
  1. % TXL ruleset for transforming from REX extended Modula-2
  2. % to original unextended Modula-2
  3. % Georg Etzkorn, GMD Karlsruhe, 25.02.91
  4.  
  5. % Grammar for REX extended Modula-2
  6. include "rmi.Grammar"
  7.  
  8.  
  9. % list of external rules
  10. external rule newId             % generates a unique new id from an old one
  11. external rule concatId SecondId [id]    % concatenates SecondId onto a first one
  12.  
  13.  
  14. % The main rule - we search each program module
  15. % for the extensions, and apply transforms to 
  16. % implement them in unextended Modula-2
  17.  
  18. function mainRule
  19.   replace [program]
  20.     P [ProgramModule]
  21.   by
  22.     P [transformHandles]
  23.       [transformCommunication] 
  24. end function
  25.  
  26.  
  27. function transformCommunication
  28.   replace [ProgramModule]
  29.       MODULE ModuleName [id] OptPrio [opt priority] ;
  30.       Imports [repeat import]
  31.       Body [block]
  32.       ModuleName [id] .
  33.  
  34.   construct PreId [id] 
  35.       XdrM2_
  36.   construct ModuleId [id]
  37.       PreId [concatId ModuleName]
  38.  
  39.   by
  40.       MODULE ModuleName OptPrio;
  41.       IMPORT ModuleId;
  42.       Imports [addCommunicationProcedureImports]
  43.       Body [addCommunicationInitAndClose]
  44.            [transformCommunicationPrimitives ModuleId] 
  45.            [transformSelectStatements ModuleId]
  46.       ModuleName . 
  47. end function
  48.  
  49.  
  50. function addCommunicationProcedureImports
  51.   replace [repeat import]
  52.       OldImports [repeat import]
  53.   by
  54.       FROM 'RexComm IMPORT
  55.       'InitComm, 'CloseComm, 
  56.       'AllocHandle, 'ReleaseHandle, 'NoHandle, 'tPortList, 'tHandle,
  57.       'AllocPortList, 'ReleasePortList, 'WaitOnPortList, 'InsertPort;
  58.       OldImports 
  59. end function
  60.  
  61.  
  62. function addCommunicationInitAndClose
  63.   replace [block]
  64.       Declarations [repeat declaration]
  65.       BEGIN
  66.       Statements [repeat statement_semi] 
  67.       END
  68.   construct CloseStatement [statement_semi]
  69.       'CloseComm();
  70.   construct NewStatements [repeat statement_semi]
  71.       'InitComm();
  72.       Statements [append_Statement CloseStatement]
  73.   by
  74.       Declarations
  75.       BEGIN
  76.       NewStatements
  77.       END
  78. end function
  79.  
  80.  
  81. external rule append_Statement NewStatement [statement_semi]
  82.  
  83.  
  84. % ------------------------------------------------------------------
  85.  
  86. rule transformCommunicationPrimitives ModuleId [id]
  87.  
  88.   construct CallId   [id]  'Call_
  89.   construct WaitId   [id]  'Wait_
  90.   construct AcceptId [id]  'Accept_
  91.   construct ReplyId  [id]  'Reply_
  92.  
  93.   construct Call   [CommName]  CALL 
  94.   construct Wait   [CommName]  WAIT
  95.   construct Accept [CommName]  ACCEPT
  96.   construct Reply  [CommName]  REPLY
  97.  
  98.   replace [statement]
  99.       CommStatement [statement]
  100.   deconstruct CommStatement
  101.       CommCall [CommunicationCall] 
  102.   by
  103.       CommStatement [transformCommunicationCall ModuleId CallId Call]
  104.                          [transformCommunicationCall ModuleId WaitId Wait]
  105.                       [transformCommunicationCall ModuleId AcceptId Accept]
  106.                       [transformCommunicationCall ModuleId ReplyId Reply]
  107. end rule
  108.  
  109.  
  110. function transformCommunicationCall ModuleId [id] CommId [id] Command [CommName]
  111.   replace [statement]
  112.       Command ( PortId [id] , ExpnList [list expression+] ) OptHandle [opt handle]
  113.  
  114.   construct NullHandle [id]  'NoHandle
  115.   construct CommHandle [id]  NullHandle [extractHandle OptHandle]
  116.   construct CommPortId [id]  CommId [concatId PortId]
  117.  
  118.   by
  119.       ModuleId.CommPortId ( ModuleId.PortId , CommHandle , ExpnList) 
  120. end function
  121.  
  122.  
  123. function extractHandle OptHandle [opt handle]
  124.     deconstruct OptHandle
  125.         WITH HandleId [id]
  126.     replace [id]
  127.     'NoHandle
  128.     by
  129.     HandleId
  130. end function
  131.  
  132.  
  133. %-------------------------------------------------------------------
  134.  
  135. rule transformHandles
  136.   replace [block]
  137.       Declarations [repeat declaration]
  138.       BEGIN 
  139.     Statements [repeat statement_semi]
  140.       END
  141.  
  142.   where
  143.       Declarations [containsHandleDeclarations]
  144.  
  145.   construct HandleDeclarations [repeat declaration]
  146.       Declarations [deleteNonVariableDeclarations]
  147.                [deleteNonHandleDeclarations]
  148.                [mergeVariableDeclarations]
  149.  
  150.   deconstruct HandleDeclarations
  151.       VAR HandleIL [list id+] : HANDLE ;
  152.  
  153.   construct HandleList [list_opt_rest_id]
  154.       , HandleIL
  155.  
  156.   by
  157.       Declarations [transformHandleDeclarations]
  158.       BEGIN
  159.       Statements [transformHandleStatements HandleList]
  160.       END
  161. end rule
  162.  
  163.  
  164. rule containsHandleDeclarations
  165.     match [SimpleType]
  166.     HANDLE
  167. end rule
  168.  
  169.  
  170. rule transformHandleDeclarations
  171.   skipping [ProcedureDeclaration]
  172.   replace [VariableDeclaration]
  173.      Idents [IdentList] : HANDLE
  174.   by
  175.      Idents : 'tHandle
  176. end rule
  177.  
  178.  
  179. rule deleteNonVariableDeclarations
  180.   skipping [ProcedureDeclaration]
  181.   replace [repeat declaration]
  182.      Declaration [declaration]
  183.      RestOfDeclarations [repeat declaration]
  184.   where
  185.      Declaration [isVarDeclaration] [not]
  186.   by
  187.      RestOfDeclarations
  188. end rule
  189.  
  190.  
  191. function isVarDeclaration
  192.     match [declaration]
  193.         VAR VD [repeat VariableDeclaration_semi]
  194. end function
  195.  
  196.  
  197. rule deleteNonHandleDeclarations
  198.     replace [repeat VariableDeclaration_semi]
  199.     VarDeclaration [VariableDeclaration_semi]
  200.     RestOfVarDeclarations  [repeat VariableDeclaration_semi]
  201.     where
  202.     VarDeclaration [isHandleDeclaration] [not]
  203.     by
  204.     RestOfVarDeclarations
  205. end rule
  206.  
  207.  
  208. function isHandleDeclaration
  209.     match [VariableDeclaration_semi]
  210.     Idents [IdentList] : HANDLE ;
  211. end function
  212.  
  213.  
  214. rule mergeVariableDeclarations
  215.     replace [repeat declaration]
  216.     VAR VarDeclaration1 [repeat VariableDeclaration_semi]
  217.     VAR VarDeclaration2 [repeat VariableDeclaration_semi]
  218.  
  219.     construct NewVarDeclaration [repeat VariableDeclaration_semi]
  220.     VarDeclaration1 [splice_VariableDeclarations VarDeclaration2] 
  221.             [mergeIdentLists]
  222.     by
  223.     VAR NewVarDeclaration
  224. end rule
  225.  
  226.  
  227. external rule splice_VariableDeclarations VarDeclaration2 [repeat VariableDeclaration_semi]
  228.  
  229.  
  230. rule mergeIdentLists
  231.     replace [repeat VariableDeclaration_semi]
  232.     Idents1 [list id+] : HANDLE ;
  233.     Idents2 [list id+] : HANDLE ;
  234.     RestOfVarDeclarations [repeat VariableDeclaration_semi]
  235.     construct NewIdents [list id+]
  236.     Idents1 [listappend_IdentList Idents2]
  237.     by
  238.     NewIdents : HANDLE ;
  239.     RestOfVarDeclarations
  240. end rule
  241.  
  242.  
  243. external rule listappend_IdentList Idents2 [list id+]
  244.  
  245.  
  246. function transformHandleStatements HandleIds [list_opt_rest_id]
  247.     deconstruct HandleIds
  248.     , HandleId [id] OptMoreHandleIds [list_opt_rest_id]
  249.     construct ReleaseHandleStatement [statement_semi]
  250.     'ReleaseHandle (HandleId);
  251.     replace [repeat statement_semi]
  252.     Statements [repeat statement_semi]
  253.     by
  254.     'AllocHandle (HandleId);
  255.     Statements [append_Statement ReleaseHandleStatement] 
  256.                [transformHandleStatements OptMoreHandleIds]
  257. end function
  258.  
  259.  
  260. %-------------------------------------------------------------
  261.  
  262. rule transformSelectStatements ModuleId [id]
  263.   replace [block]
  264.       Declarations [repeat declaration]
  265.       BEGIN 
  266.     Statements [repeat statement_semi]
  267.       END
  268.   where
  269.       Statements [containsSelectStatement]
  270.  
  271.   construct RawPortListId [id]  'XdrM2_PortList
  272.   construct PortListId [id]     RawPortListId [newId]
  273.  
  274.   by
  275.       VAR PortListId : 'tPortList ;
  276.       Declarations
  277.       BEGIN
  278.     Statements [transformSelectStatement ModuleId PortListId]
  279.       END
  280. end rule
  281.  
  282.  
  283. rule containsSelectStatement
  284.     match [statement]
  285.     Statement [SelectStatement]
  286. end rule
  287.  
  288.  
  289. rule transformSelectStatement ModuleId [id] PortListId [id]
  290.   replace [repeat statement_semi]
  291.       SELECT
  292.     FirstAlternative [alternative] 
  293.     RestOfAlternatives [repeat or_alternative] 
  294.     OptElse [opt else_StatementSequence]
  295.       END ;
  296.       RestOfStatements [repeat statement_semi]
  297.  
  298.   construct AllocPortListStatement [repeat statement_semi]
  299.       'AllocPortList (PortListId);   
  300.  
  301.   construct PortListStatements [repeat statement_semi]
  302.       AllocPortListStatement 
  303.       [mapAlternativeToIf FirstAlternative PortListId ModuleId]
  304.       [mapAlternativesToIfs RestOfAlternatives PortListId ModuleId]
  305.  
  306.   construct emptyOrCase [repeat or_case]
  307.     %% nothing
  308.   construct OrCases [repeat or_case]
  309.         emptyOrCase [mapAlternativeToCase FirstAlternative ModuleId]
  310.             [mapAlternativesToCases RestOfAlternatives ModuleId] 
  311.  
  312.   deconstruct OrCases
  313.     '| FirstCase [case]
  314.        RestOfCases [repeat or_case]
  315.  
  316.   construct CaseWaitOnPortList [statement_semi]
  317.     CASE 'WaitOnPortList (PortListId) OF
  318.       FirstCase 
  319.       RestOfCases
  320.     END;
  321.  
  322.   construct ReleasePortListStatement [statement_semi]
  323.     'ReleasePortList (PortListId);
  324.  
  325.   construct NewStatements [repeat statement_semi]
  326.       PortListStatements [append_Statement CaseWaitOnPortList]
  327.              [append_Statement ReleasePortListStatement]
  328.              [splice_Statements RestOfStatements]
  329.   by
  330.       NewStatements
  331. end rule
  332.  
  333.  
  334. external rule splice_Statements NewStatements [repeat statement_semi]
  335.  
  336.  
  337. function mapAlternativesToCases Alternatives [repeat or_alternative] ModuleId [id]
  338.   deconstruct Alternatives
  339.       '| FirstAlternative [alternative] 
  340.       RestOfAlternatives [repeat or_alternative]
  341.   replace [repeat or_case]
  342.       OrCases [repeat or_case]
  343.   by 
  344.       OrCases [mapAlternativeToCase FirstAlternative ModuleId]
  345.           [mapAlternativesToCases RestOfAlternatives ModuleId] 
  346. end function
  347.  
  348.  
  349. function mapAlternativeToCase Alternative [alternative] ModuleId [id]
  350.   deconstruct Alternative
  351.       OptExpnAnd [opt BoolAnd] CommCall [CommunicationCall] : 
  352.       AlternativeStatements [repeat statement_semi] 
  353.   deconstruct CommCall
  354.       CommOp [CommName] ( PortId [id] , ExpnList [ExpList] ) OptHandle [opt handle]
  355.   construct CommStatement [statement]
  356.       CommCall
  357.   replace [repeat or_case]
  358.       RestOfCases [repeat or_case]
  359.   by
  360.       '| ModuleId.PortId : 
  361.       CommStatement [transformCommunicationPrimitives ModuleId] ; 
  362.       AlternativeStatements
  363.       RestOfCases 
  364. end function
  365.  
  366.  
  367. function mapAlternativesToIfs Alternatives [repeat or_alternative] PortListId [id] ModuleId [id]
  368.   deconstruct Alternatives
  369.     '| FirstAlternative [alternative] 
  370.     RestOfAlternatives [repeat or_alternative]
  371.   replace [repeat statement_semi]
  372.       Statements [repeat statement_semi]
  373.   by 
  374.       Statements [mapAlternativeToIf FirstAlternative PortListId ModuleId]
  375.              [mapAlternativesToIfs RestOfAlternatives PortListId ModuleId] 
  376. end function
  377.  
  378.  
  379. function mapAlternativeToIf Alternative [alternative] PortListId [id] ModuleId [id]
  380.   deconstruct Alternative
  381.       Guard [guard] : 
  382.       AlternativeStatements [StatementSequence] 
  383.   replace [repeat statement_semi]
  384.       Statements [repeat statement_semi] 
  385.   by 
  386.       Statements [buildGuard1 Guard PortListId ModuleId]
  387.                  [buildGuard2 Guard PortListId ModuleId]
  388. end function
  389.  
  390.  
  391. function buildGuard1 Guard [guard] PortListId [id] ModuleId [id]
  392.   deconstruct Guard
  393.       Expn [expression] &&
  394.           CommOp [CommName]  ( PortId [id] , ExpnList [ExpList] ) OptHandle [opt handle]
  395.  
  396.   construct NullHandle [id]  'NoHandle
  397.   construct HandleId [id]    NullHandle [extractHandle OptHandle]
  398.  
  399.   construct IfStatement [statement_semi]
  400.       IF Expn THEN 
  401.       'InsertPort (PortListId, ModuleId.PortId, HandleId); 
  402.       END;
  403.  
  404.   replace [repeat statement_semi]
  405.       Statements [repeat statement_semi]
  406.  
  407.   construct NewStatements [repeat statement_semi]
  408.       Statements [append_Statement IfStatement]
  409.   by
  410.       NewStatements
  411. end function
  412.  
  413.  
  414. function buildGuard2 Guard [guard] PortListId [id] ModuleId [id]
  415.   deconstruct Guard
  416.       CommOp [CommName]  ( PortId [id] , ExpnList [ExpList] ) OptHandle [opt handle]
  417.  
  418.   construct NullHandle [id]  'NoHandle
  419.   construct HandleId [id]    NullHandle [extractHandle OptHandle]
  420.  
  421.   construct InsertPortStatement [statement_semi]
  422.       'InsertPort (PortListId, ModuleId.PortId, HandleId); 
  423.  
  424.   replace [repeat statement_semi]
  425.       Statements [repeat statement_semi]
  426.  
  427.   construct NewStatements [repeat statement_semi]
  428.       Statements [append_Statement InsertPortStatement]
  429.   by
  430.       NewStatements
  431. end function
  432.